	COMMON IOS,NAP
	CHARACTER*15 RECORD
	CHARACTER*4 YEAR,CBTT,T,STCH(4),SNCH(4)
	CHARACTER*3 QU
	CHARACTER*7 ACT
	CHARACTER*12 NUM
	CHARACTER*10 ADD
	CHARACTER*7 DAT,ADCH
	CHARACTER*6 AD,SAD
	CHARACTER*2 COD,MO,AR
	CHARACTER*27 ALPHA
	CHARACTER*3 ANS
	CHARACTER*12 MARK,CMARK
	DIMENSION REAL(12),CEAL(12),IC(10),MMO(12)
C
C
	OPEN(UNIT=1,FILE='HYDROMET:[MPOLL]MONTHLY.IND',STATUS='OLD',
	1ORGANIZATION='INDEXED',ACCESS='KEYED',
	2RECORDTYPE='FIXED',SHARED,FORM='UNFORMATTED',RECL=18,
	3KEY=(1:10:CHARACTER),IOSTAT=IOS,ERR=9999)
C
C
C
	DATA IC/1,3,5,6,7,9,11,13,14,52/
	DATA MMO/1,2,3,4,5,6,7,8,9,10,11,12/
	DATA SNCH/'OCWO','PRIO','UNY ','JCKY'/
	DATA STCH/'OCH ','PRV ','UNY ','JCK '/
	ALPHA='ABCDEFGHIJKLMNOPQRSTUVWXYZ '
	NUM='0123456789. '
C
C
1	FORMAT(3A)
2	FORMAT(' DATA CODE IS NOT 1,3,5,6,7,9,11,  CODE=',A)
3	FORMAT(' ENTER WATER YEAR>',$)
4	FORMAT(A)
5	FORMAT(' YEAR ENTERED=',A/,' ENTER WATER YEAR>',$)
6	FORMAT(' WATER YEAR=',A/,' IS IT CORRECT?',$)
7	FORMAT(I4)
8	FORMAT(' I QUESTION WATER YEAR. WY=',A/,' IS IT CORRECT?',$)
9	FORMAT(I2)
11	FORMAT(' ERROR IN DECODING MONTH, DATA=',3A,2X,'IOS=',I2)
12	FORMAT(' DATA IS NOT CORRECT CODE=',A)
13	FORMAT(' ERROR IN CBTT NAME.  CBTT=',A)
14	FORMAT(' ERROR ON CLOSE,IOS=',I2,',UNIT=1')
15	FORMAT(' ERROR IN READ UNIT=1, IOS=',I2,/,A12,6F11.2/12X,6F11.2)
16	FORMAT(' ERROR ON REWRITE IOS=',I2,A12,6F11.2/12X,6F11.2)
17	FORMAT(' ERROR ON OPEN UNIT=1, IOS=',I2)
21	FORMAT(F7.0)
50	FORMAT(' ERROR IN DECODING YEAR, YEAR=',A)
51	FORMAT(1X,A,2X,'IOS=',I2)
52	FORMAT(' MONTHLY FILE NOT UPDATED',/1X,2A,1X,A)
53	FORMAT(' ERROR IN DATA FOR RECORD=',2A)
54	FORMAT(' ERROR ON WRITE TO INDEX FILE IOS=',I2,A12,6F11.2/12X,6F11.2)
55	FORMAT(' ERROR ON READ BEFORE REWRITE IOS=',I2,A)
57	FORMAT(1X,'ALPHA DATA  ',A)
C
C
	QU='   '
100	WRITE(6,3)
	READ(6,4)YEAR
	DO 25 K=1,4
	NO=0
	DO 26 I=1,10
	IF(YEAR(K:K).EQ.NUM(I:I))NO=1
26	CONTINUE
	DO 24 I=1,12
	MARK(I:I)=' '
24	CONTINUE
	IF(NO.NE.1)THEN
			WRITE(6,5)YEAR
			GO TO 100
			END IF
25	CONTINUE
	WRITE(6,6)YEAR
	READ(6,4)ANS
	IF(ANS.NE.'YES')GO TO 100
	DECODE(4,7,YEAR,ERR=111)IYR
	GO TO 112
111	WRITE(6,50)YEAR
	GO TO 100
112	CALL IDATE(IM,ID,IY)
	IY=IY+1900
	IF(IM.GT.9)IY=IY+1
	IF(IYR.GT.IY)THEN
27			WRITE(6,8)YEAR
			READ(6,4)ANS
			IF(ANS(1:2).EQ.'NO')GO TO 100
			IF(ANS.EQ.'YES')GO TO 101
			GO TO 27
101			END IF
110	IND=1
107	READ(2,1,END=200)RECORD
	DO 34 IQ=9,15
	ISW=0
	DO 36 KQ=1,12
	IF(RECORD(IQ:IQ).EQ.NUM(KQ:KQ))ISW=1
36	CONTINUE
	IF(ISW.NE.1)THEN
		WRITE(6,57)RECORD
		GO TO 107
		END IF
34	CONTINUE				
	GO TO 203
200	QU='END'
	RECORD='A    1 1       '
203	T='NREA'
	NAP=0
	AD=RECORD(1:6)
	IF(AD(5:5).EQ.'0')AD(5:5)=' '
	DO 60 I=1,4
	ADCH=STCH(I)//' 7'
	IF(AD(1:6).EQ.ADCH)AD(1:4)=SNCH(I)
60	CONTINUE
	MO=RECORD(7:8)
	DAT=RECORD(9:15)
	IF(RECORD.EQ.'               ')GO TO 107
29	DECODE(2,9,AD(5:6),ERR=30,IOSTAT=IOS)ID
	DO 28 I=1,10
	IF(ID.EQ.IC(I))GO TO 105
28	CONTINUE
30	WRITE(6,51)RECORD,IOS
	WRITE(6,12)AD(5:6)
	GO TO 107
105	DECODE(2,9,MO,ERR=103,IOSTAT=IOS)MON
	GO TO 104
103	WRITE(6,11)AD,MO,DAT,IOS
	GO TO 107
104	NO=0
	DO 31 I=1,12
	IF(MON.EQ.MMO(I))NO=1
31	CONTINUE
	IF(NO.NE.1)THEN
			IOS=0
			WRITE(6,11)AD,MO,DAT,IOS
			GO TO 107
			END IF
106	NO=0
	DO 32 I=1,4
	K=26
	IF(I.EQ.4)K=27
	DO 33 J=1,K
	IF(AD(I:I).EQ.ALPHA(J:J))NO=1
33	CONTINUE
32	CONTINUE
	IF(NO.NE.1)THEN
			WRITE(6,13)(AD(I:I),I=1,4)
			GO TO 107
			END IF
	DECODE(7,21,DAT,ERR=109,IOSTAT=IOS)REA
	IF(RECORD(5:6).EQ.'52')THEN
	 IF(REA.EQ.0.OR.REA.EQ.1.OR.REA.EQ.-1.)GO TO 114
	 WRITE(6,57)RECORD
	 GO TO 107
	 END IF
	GO TO 114
109	WRITE(6,53)AD,DAT,IOS
	GO TO 107
114	IF(IND.EQ.1)THEN
		ADD=AD//YEAR
400		READ(UNIT=1,KEY=ADD,KEYID=0,IOSTAT=IOS,ERR=9998)ADD,REAL,MARK
		UNLOCK 1
		IF(IOS.EQ.0)ACT='REWRITE'
		GO TO 401
9998		IF(IOS.EQ.52)CALL RECLOCK(*500,*400)
		IF(IOS.EQ.36)THEN
			ACT='WRITE  '
			DO 403 IK=1,12
			REAL(IK)=998877.
403			CONTINUE
			GO TO 401
			END IF
		WRITE(6,15)IOS,ADD,REAL
		IF(RECORD.EQ.'A    1 1       ')GO TO 202
		GO TO 107
401		SAD=ADD(1:6)
		IND=0
		END IF
	IF(MON.GT.9)THEN
		MON=MON-9
		GO TO 402
		END IF
	IF(MON.LT.10)MON=MON+3
402	IF(AD.NE.SAD)THEN
		IF(ACT.EQ.'REWRITE')THEN
		READ(UNIT=1,KEY=ADD,KEYID=0,IOSTAT=IOS,ERR=9991)ADD,CEAL,CMARK
		REWRITE(UNIT=1,IOSTAT=IOS,ERR=9997)ADD,REAL,MARK
		UNLOCK 1
		IND=1
		ELSE IF(ACT.EQ.'WRITE  ')THEN
		WRITE(UNIT=1,IOSTAT=IOS,ERR=9996)ADD,REAL,MARK
		IND=1
		END IF
		IF(QU.EQ.'END')GO TO 202
		IF(T.EQ.'READ')GO TO 107
		T='READ'
		GO TO 105
		END IF
	REAL(MON)=REA
	MARK(MON:MON)=' '
	GO TO 107
9996	WRITE(6,54)IOS,ADD,REAL
	GO TO 107
9997	WRITE(6,16)IOS,ADD,REAL
	GO TO 107
9991	WRITE(6,55)IOS,ADD
	GO TO 107
500	WRITE(6,52)ADD,DAT,RECORD
	GO TO 110
202	CLOSE(UNIT=1,ERR=9995,IOSTAT=IOS)
	GO TO 201
9995	WRITE(6,14)IOS
9999	WRITE(6,17)IOS
201	STOP
	END
	SUBROUTINE RECLOCK(*,*)
C
C	TRIES TO READ LOCKED RECORD 5 TIMES AT 1 SECOND INTERVALS
C
	COMMON NAP,IOS
C
	LOGICAL*1 BTIME(8)
C
	CHARACTER ATIM*13
C
	DATA ATIM/'0 00:00:01.00'/
C
!	WRITE(6,2) NAP,IOS
!2	FORMAT(1X,'RECORD LOCKED, NAP = ',I2,', IOS = ',I2)
C
	ISTAT=SYS$BINTIM(ATIM,BTIM)	! GET BINARY PAUSE
	RETVAR=SYS$SCHDWK(,,BTIM,)
	RETVAR=SYS$HIBER()	! FALL ASLEEP FOR 1 SECOND
	NAP=NAP+1
	IF(NAP.LT.10) RETURN 2
	WRITE(6,1) IOS
1	FORMAT(1X,'ERROR ON READ IN RECLOCK, IOS = ',I2)
	NAP=0
	RETURN 1
	END
